home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / hash / Graphs / GRAPHSU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-11-22  |  7.1 KB  |  296 lines
  1. unit GraphsU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Image1: TImage;
  13.     Button2: TButton;
  14.     Button3: TButton;
  15.     Label1: TLabel;
  16.     Edit1: TEdit;
  17.     Label2: TLabel;
  18.     Button4: TButton;
  19.     procedure Button1Click(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure Button3Click(Sender: TObject);
  22.     procedure Button2Click(Sender: TObject);
  23.     procedure Button4Click(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. var
  38.   Root2Pi : double;
  39.   EToMinus1 : double;
  40.   EToMinus2 : double;
  41.  
  42. function Normal(x : double) : double;
  43. begin
  44.   Result := exp(-(X*X)/2.0)/Root2Pi;
  45. end;
  46.  
  47. function Poisson(x    : integer;
  48.                  Mean : double) : double;
  49. var
  50.   MeanPower : double;
  51.   Factorial : double;
  52.   i         : integer;
  53. begin
  54.   if (x = 0) then
  55.     MeanPower := 1.0
  56.   else begin
  57.     MeanPower := Mean;
  58.     if x > 1 then
  59.       for i := 2 to x do
  60.         MeanPower := MeanPower * Mean;
  61.   end;
  62.   if (x <= 1) then
  63.     Result := MeanPower * exp(-Mean)
  64.   else begin
  65.     Factorial := 1.0;
  66.     for i := 2 to x do
  67.       Factorial := Factorial * x;
  68.     Result := MeanPower * exp(-Mean) / Factorial;
  69.   end;
  70. end;
  71.  
  72. function XPixel(x         : double;
  73.                 PixelZero : integer;
  74.                 PixelWidth: integer;
  75.                 RealWidth : double) : integer;
  76. begin
  77.   Result := trunc(PixelZero + (x * (PixelWidth / RealWidth)));
  78. end;
  79.  
  80. function YPixel(y          : double;
  81.                 PixelZero  : integer;
  82.                 PixelHeight: integer;
  83.                 RealHeight : double) : integer;
  84. begin
  85.   Result := trunc(PixelZero - (y * (PixelHeight / RealHeight)));
  86. end;
  87.  
  88. procedure TForm1.Button1Click(Sender: TObject);
  89. var
  90.   Wd, Ht : integer;
  91.   XAxis, YAxis : integer;
  92.   x, y : double;
  93.   RealWidth : double;
  94.   StopX     : double;
  95.   StartTick, TickLen : integer;
  96. begin
  97.   Wd := Image1.Width;
  98.   Ht := Image1.Height;
  99.   XAxis := Ht - (Ht div 6);
  100.   YAxis := Wd div 2;
  101.   RealWidth := 8.0;
  102.  
  103.   with Image1.Canvas do begin
  104.     {clear it}
  105.     FillRect(Rect(0, 0, Wd, Ht));
  106.     {draw axes}
  107.     Pen.Color := clBlack;
  108.     Pen.Width := 1;
  109.     MoveTo(0, XAxis);
  110.     LineTo(Wd, XAxis);
  111.     MoveTo(YAxis, XAxis);
  112.     LineTo(YAxis, 0);
  113.  
  114.     {draw tick marks on XAxis}
  115.     x := -(RealWidth / 2.0);
  116.     StartTick := XPixel(x, YAxis, Wd, RealWidth);
  117.     if (abs(x - round(x)) < 0.09) then
  118.       TickLen := 5
  119.     else
  120.       TickLen := 3;
  121.     MoveTo(StartTick, XAxis);
  122.     LineTo(StartTick, XAxis - TickLen);
  123.     StopX := -x;
  124.     while x < StopX do begin
  125.       x := x + 0.1;
  126.       StartTick := XPixel(x, YAxis, Wd, RealWidth);
  127.       if (abs(x - round(x)) < 0.09) then
  128.         TickLen := 5
  129.       else
  130.         TickLen := 3;
  131.       MoveTo(StartTick, XAxis);
  132.       LineTo(StartTick, XAxis - TickLen);
  133.       if (TickLen = 5) then
  134.         TextOut(StartTick - 5, XAxis + 5,
  135.                 Format('%.1f', [x]));
  136.     end;
  137.  
  138.     {draw tick marks on YAxis}
  139.     y := 0.0;
  140.     StartTick := YPixel(y/10.0, XAxis, XAxis, 0.5);
  141.     if (abs(y - round(y)) < 0.09) then
  142.       TickLen := 5
  143.     else
  144.       TickLen := 3;
  145.     MoveTo(YAxis, StartTick);
  146.     LineTo(YAxis + TickLen, StartTick);
  147.     while y < 5.0 do begin
  148.       y := y + 0.1;
  149.       StartTick := YPixel(y/10.0, XAxis, XAxis, 0.5);
  150.       if (abs(y - round(y)) < 0.09) then
  151.         TickLen := 5
  152.       else
  153.         TickLen := 3;
  154.       MoveTo(YAxis, StartTick);
  155.       LineTo(YAxis + TickLen, StartTick);
  156.       if (TickLen = 5) then
  157.         TextOut(YAxis + TickLen, StartTick,
  158.                 Format('%.1f', [y/10.0]));
  159.     end;
  160.  
  161.     Pen.Color := clRed;
  162.     Pen.Width := 2;
  163.     x := -(RealWidth / 2.0);
  164.     y := Normal(x);
  165.     MoveTo(XPixel(x, YAxis, Wd, RealWidth),
  166.            YPixel(y, XAxis, XAxis, 0.5));
  167.     StopX := -x;
  168.     while x < StopX do begin
  169.       x := x + 0.1;
  170.       y := Normal(x);
  171.       LineTo(XPixel(x, YAxis, Wd, RealWidth),
  172.              YPixel(y, XAxis, XAxis, 0.5));
  173.     end;
  174.     TextOut(10, 10, 'Standard Normal Curve');
  175.   end;
  176. end;
  177.  
  178. procedure TForm1.FormCreate(Sender: TObject);
  179. begin
  180.   Root2Pi := Sqrt(2 * Pi);
  181.   EToMinus1 := exp(-1.0);
  182.   EToMinus2 := exp(-2.0);
  183. end;
  184.  
  185. procedure TForm1.Button3Click(Sender: TObject);
  186. begin
  187.   Close;
  188. end;
  189.  
  190. procedure TForm1.Button2Click(Sender: TObject);
  191. var
  192.   Wd, Ht : integer;
  193.   XAxis, YAxis : integer;
  194.   x, y : double;
  195.   RealWidth  : double;
  196.   RealHeight : double;
  197.   StopX      : double;
  198.   StartTick, TickLen : integer;
  199.   Mean : double;
  200. begin
  201.   Mean := StrToFloat(Edit1.Text);
  202.   RealHeight := Poisson(round(Mean/2.0), Mean) * 1.5;
  203.   Wd := Image1.Width;
  204.   Ht := Image1.Height;
  205.   XAxis := Ht - (Ht div 6);
  206.   YAxis := 10;
  207.   RealWidth := 8.0;
  208.  
  209.   with Image1.Canvas do begin
  210.     {clear it}
  211.     FillRect(Rect(0, 0, Wd, Ht));
  212.     {draw axes}
  213.     Pen.Color := clBlack;
  214.     Pen.Width := 1;
  215.     MoveTo(0, XAxis);
  216.     LineTo(Wd, XAxis);
  217.     MoveTo(YAxis, XAxis);
  218.     LineTo(YAxis, 0);
  219.  
  220.     {draw tick marks on XAxis}
  221.     x := 0.0;
  222.     StartTick := XPixel(x, YAxis, Wd, RealWidth);
  223.     if (abs(x - round(x)) < 0.09) then
  224.       TickLen := 5
  225.     else
  226.       TickLen := 3;
  227.     MoveTo(StartTick, XAxis);
  228.     LineTo(StartTick, XAxis - TickLen);
  229.     StopX := RealWidth;
  230.     while x < StopX do begin
  231.       x := x + 0.1;
  232.       StartTick := XPixel(x, YAxis, Wd, RealWidth);
  233.       if (abs(x - round(x)) < 0.09) then
  234.         TickLen := 5
  235.       else
  236.         TickLen := 3;
  237.       MoveTo(StartTick, XAxis);
  238.       LineTo(StartTick, XAxis - TickLen);
  239.       if (TickLen = 5) then
  240.         TextOut(StartTick - 5, XAxis + 5,
  241.                 Format('%.1f', [x]));
  242.     end;
  243.  
  244.     {draw tick marks on YAxis}
  245.     y := 0.0;
  246.     StartTick := YPixel(y/10.0, XAxis, XAxis, RealHeight);
  247.     if (abs(y - round(y)) < 0.09) then
  248.       TickLen := 5
  249.     else
  250.       TickLen := 3;
  251.     MoveTo(YAxis, StartTick);
  252.     LineTo(YAxis + TickLen, StartTick);
  253.     while y < (RealHeight*10.0) do begin
  254.       y := y + 0.1;
  255.       StartTick := YPixel(y/10.0, XAxis, XAxis, RealHeight);
  256.       if (abs(y - round(y)) < 0.09) then
  257.         TickLen := 5
  258.       else
  259.         TickLen := 3;
  260.       MoveTo(YAxis, StartTick);
  261.       LineTo(YAxis + TickLen, StartTick);
  262.       if (TickLen = 5) then
  263.         TextOut(YAxis + TickLen, StartTick,
  264.                 Format('%.1f', [y/10.0]));
  265.     end;
  266.  
  267.     Pen.Color := clRed;
  268.     Pen.Width := 2;
  269.     x := 0.0;
  270.     y := Poisson(round(x), Mean);
  271.     MoveTo(XPixel(x, YAxis, Wd, RealWidth),
  272.            YPixel(y, XAxis, XAxis, RealHeight));
  273.     StopX := RealWidth;
  274.     while x < StopX do begin
  275.       x := x + 1.0;
  276.       y := Poisson(round(x), Mean);
  277.       LineTo(XPixel(x, YAxis, Wd, RealWidth),
  278.              YPixel(y, XAxis, XAxis, RealHeight));
  279.     end;
  280.     TextOut(100, 10, 'Poisson Curve');
  281.   end;
  282. end;
  283.  
  284.  
  285. procedure TForm1.Button4Click(Sender: TObject);
  286. var
  287.   Mean : double;
  288. begin
  289.   Mean := StrToFloat(Edit1.Text);
  290.   Mean := Mean + 0.1;
  291.   Edit1.Text := FloatToStr(Mean);
  292.   Button2Click(Sender);
  293. end;
  294.  
  295. end.
  296.